home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / a_select < prev    next >
Text File  |  1996-06-01  |  4KB  |  106 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- select.sa: Selection and order stats
  3. -- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
  4. -- Copyright (C) 1995, International Computer Science Institute
  5. -- $Id: a_select.sa,v 1.3 1996/06/01 21:36:11 gomes Exp $
  6. --
  7. -- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
  8. -- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
  9. -- LICENSE contained in the file: Sather/Doc/License of the
  10. -- Sather distribution. The license is also available from ICSI,
  11. -- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
  12. -------------------------------------------------------------------
  13.  
  14. class A_SELECT{ETP,ATP< $ARR{ETP}} is
  15.    -- Basic algorithms for order statistics
  16.    -- Most of these algorithms MODIFY THE ORIGINAL ARRAY! 
  17.    include COMPARE{ETP};
  18.    
  19.    median_modifying(a: ATP): ETP is
  20.       -- The median of the elements contained in 'a' according to the 
  21.       -- ordering relation `elt_lt'. Permutes the elements of 'a'. Void 
  22.       -- if self is empty
  23.       if a.size<=0 then return void end;
  24.       m::=(a.size-1)/2; 
  25.       return select_modifying(a,m,0,a.size-1); 
  26.    end;
  27.    
  28.    select_modifying(a: ATP,i:INT,lp,up: INT): ETP 
  29.    -- Modifies "a"
  30.    -- Move the elements of a so that the element with index `i' is 
  31.    -- not `elt_lt' any element with lower indices and no element with
  32.    -- a larger index is `elt_lt' it.
  33.    -- Use the subarray in the range l,u
  34.    -- Return the "ith" element in the rearranged array
  35.       pre check_index(a,i,lp,up)
  36.    is
  37.       l::=lp; u::=up;
  38.       loop until!(l>=u);       -- [0 to l-1] <= [l to u] <= [u+1 to size-1]
  39.      r::= RND::int(l,u);  
  40.      t ::= a[r];
  41.      swap(a,l,r);      -- Exchange the middle index with low
  42.      m::=l;            -- Set the "clean" index m to low
  43.      loop j::=(l+1).upto!(u);  -- Clean up the array above "l" below "m" 
  44.         if elt_lt(a[j],t) then    m:=m+1; swap(a,m,j);   end 
  45.      end;
  46.      -- Exchange the end of the clean values (index m, which is clean)
  47.      -- with the low index (which is not clean)
  48.      swap(a,l,m); -- [l->m-1] <= [m] <= [m+1->u]
  49.      -- Shift the active range
  50.      if m<=i then l:=m+1 end; -- Use the upper range
  51.      if m>=i then u:=m-1 end -- Use the lower range
  52.       end;
  53.       return a[i];
  54.    end; 
  55.  
  56.    select_modifying(a:ATP,lt:ROUT{ETP,ETP}:BOOL, i:INT,lp,up: INT):ETP
  57.    -- Modifies 'a'
  58.    -- Move the elements of 'a' so that the element with index `i' is 
  59.    -- not `lt' any element with lower indices and no element with
  60.    -- a larger index is `lt' it.
  61.       pre check_index(a,i,lp,up)
  62.    is
  63.       l::=lp; u::=up;
  64.       loop until!(l>=u);       -- [0 to l-1] <= [l to u] <= [u+1 to size-1]
  65.      r::= RND::int(l,u);  
  66.      t ::= a[r]; swap(a,l,r);      
  67.      m::=l;            
  68.      loop j::=(l+1).upto!(u); 
  69.         if lt.call(a[j],t) then    m:=m+1; swap(a,m,j);   end 
  70.      end;
  71.      t := a[l];  swap(a,l,m); -- [l->m-1] <= [m] <= [m+1->u]
  72.      if m<=i then l:=m+1 end; -- Use the upper range
  73.      if m>=i then u:=m-1 end -- Use the lower range
  74.       end;
  75.       return a[i];
  76.    end;   
  77.  
  78.    private swap(a: ATP,i,j: INT) is 
  79.       tmp ::= a[i];
  80.       a[i] := a[j];
  81.       a[j] := tmp;
  82.    end;
  83.  
  84.    private swap(a: ATP,order: ARRAY{INT},i,j: INT) is 
  85.       tmp ::= order[i]; 
  86.       order[i] := order[j];
  87.       order[j] := tmp;
  88.    end;
  89.    
  90.    private check_index(a: ATP,i: INT,l,u: INT): BOOL is
  91.       if void(a) then
  92.      #ERR+"The array for selection is void!\n"; return false;
  93.       end;
  94.       if i.is_bet(l,u) and l.is_bet(0,a.size-1) and u.is_bet(l,a.size-1) then
  95.      return true;
  96.       else
  97.      #ERR+"Can't select the specified index:"+i+" in:["+l+","+u+"]\n";
  98.      #ERR+"The array is of size:"+a.size+"\n";
  99.      return false;
  100.       end;
  101.    end;
  102.  
  103. end; -- class A_SELECT{ETP}
  104. -------------------------------------------------------------------
  105.  
  106.